home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
PRG
/
ICProgKit 1.3.sit
/
ICProgKit1.3
/
Goodies
/
ICGenericOverride
/
ICGenericOverride.p
next >
Wrap
Text File
|
1995-04-23
|
15KB
|
432 lines
unit ICGenericOverride;
(* Internet Config Generic Overide Component *)
(* Routine names have an ICGO prefix for Internet Config Generic Override. *)
(* This component is the framework for an Internet Config override *)
(* component. I've used it to replace the original IC ReadOnly and *)
(* IC RandomSignature components bodies with one common body. *)
(* The different between the two components is now contained isolated *)
(* in a separate file, ICSpecificOverride. *)
(* The component overrides the Internet Config Extension and *)
(* passes all calls through to the specific override to determine *)
(* whether it should be overridden. *)
(* This code has followed a fairly long path--Jager was the one who *)
(* originally started the work on the Random Signature component. *)
(* I based my code on his code and tried to get it work, in the *)
(* process finding and using some sample code from a develop article. *)
(* Eric translated the generic parts of Random Signature to C to *)
(* implement a component of his own (fixing bugs and rewriting along *)
(* the way), and then modified to duplicate the behavior of *)
(* IC ReadOnly. Since then I have ported the changes back to Pascal *)
(* to form the basis of this generic override component, which I've *)
(* used for the IC 1.1 override components. *)
(* Consider it a collaborative work, as Eric *)
(* says "a bit of a Frankenstein's monster". *)
(* This release fixes a nasty bug in the Pascal example components, one which *)
(* prevents them from loading if their manufacturer code comes after *)
(* that of a previously registered component. If you use any component *)
(* based on this code, the old versions of IC ReadOnly and Random *)
(* Signature will probably stop working. *)
(* If you're implementing a component of your own, I strongly suggest *)
(* you contact either Eric or myself first. In any event, read *)
(* the section on the component manager in Inside Macintosh: More *)
(* Macintosh Toolbox very closely and test your component thoroughly. *)
(* You'll definitely want some tools off of develop 15, including *)
(* Komponent Killer, Reinstaller II and the "thing" dcmd. *)
(* This code is probably of adequate quality for most uses, but if *)
(* you are using it to implement a commercial-quality system, you *)
(* may want to rewrite it from the ground up. *)
(* Quinn "The Eskimo!" *)
(* with vast plagarism from... *)
(* Eric Kidd *)
(* eric.kidd@dartmouth.edu *)
(* Thanks for all the work Eric! *)
interface
uses
Components;
function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
implementation
uses
{$ifc undefined THINK_Pascal}
Types, Files, QuickDraw, Aliases, Packages, Memory, Errors, ToolUtils, Resources,
ICTypes,
{$endc}
Folders, ICCAPI, ICKeys, ICComponentSelectors, ICSpecificOverride;
function ICGODecStr (l: longint): Str32;
var
tmpstr: Str255;
begin
NumToString(l, tmpstr);
ICGODecStr := tmpstr;
end; (* ICGODecStr *)
(* ICGOFixCloneRefCon *)
(* See Inside Macintosh: More Macintosh Toolbox p. 6-35 for *)
(* an overview of this silliness. It seems that when your globally- *)
(* registered component is opened by an application, the system *)
(* pulls a fast one under "certain circumstances" (not enough memory *)
(* in the system heap) and "clones" a locally-registered version *)
(* of your component, frying your RefCon in process. *)
(* What we need to do is determine if this is the case, and if so, *)
(* recover the RefCon by locating the original copy of the component. *)
(* The Officially Sactioned Way to do this is a bit of a hack. Global *)
(* components have an A5 world of zero when they are opened, but local *)
(* ones have it pre-set to the parent application's value. If your *)
(* supposedly global component detects that it has a pre-set A5 world, *)
(* then it's been cloned. *)
(* To find the original copy of the component (which has the RefCon we *)
(* need), we need to find another component that looks exactly like us, *)
(* with the exception of a different component identifier. Unless we've *)
(* been registered globally multiple times under the same name, this *)
(* should work. FindNextComponent will do the job here. *)
(* The "practical upshot" of this: *)
(* 1) Only call this routine when handling open messages *)
(* 2) Call it before setting your instance's A5 world *)
(* 3) Only call it if you should have been global *)
(* 4) It won't work if you've been registered multiple times *)
(* under the same name. *)
(* 5) Don't use the same manufacturer code for different *)
(* components with the same type/subtype *)
(* 6) It may not work at all. I'm a college student, dammit, not a *)
(* programming guru. *)
(* Eric Kidd *)
(* eric.kidd@dartmouth.edu *)
(* 16 Dec 94 *)
function ICGOFixCloneRefCon (self: ComponentInstance): ComponentResult;
var
err: OSErr;
junk: OSErr;
cd: ComponentDescription;
current: Component;
begin
err := noErr;
if (GetComponentRefcon(Component(self)) = 0) & (GetComponentInstanceA5(self) <> 0) then begin
(* if this component has not been opened & setup*)
(* and we've been cloned*)
(* get enough info about ourself to recognize the original *)
junk := GetComponentInfo(Component(self), cd, nil, nil, nil);
cd.componentFlagsMask := 0; (* these shouldn't be relevant *)
current := nil;
repeat
(* loop until we find someone other than ourself *)
current := FindNextComponent(current, cd);
until current <> Component(self);
(* We didn't find any original--this happens often.*)
(* If we've been captured, we can't find the original*)
(* copy. Best thing to do is return an error.*)
if current = nil then begin
err := paramErr;
end
else begin
SetComponentRefcon(Component(self), GetComponentRefcon(current));
end; (* if *)
end; (* if *)
ICGOFixCloneRefCon := err;
end; (* ICGOFixCloneRefCon *)
function ICGOGetSharedGlobals (globals: globalsHandle): ComponentResult;
(* If the shared have not yet been allocated, we'll try to set them*)
(* up and return them.*)
var
err: ComponentResult;
shared: sharedGlobalsPtr;
junk: OSErr;
begin
shared := sharedGlobalsPtr(GetComponentRefcon(Component(globals^^.self)));
globals^^.shared := shared;
if shared = nil then begin
shared := sharedGlobalsPtr(NewPtrSysClear(sizeof(sharedGlobals)));
err := MemError;
if err = noErr then begin
globals^^.shared := shared;
(* init our part of the shared globals *)
shared^.delegate := nil;
(* and remember the shared globals in our refcon *)
SetComponentRefcon(Component(globals^^.self), longint(shared));
(* Since our shared globals get set up only once at registration*)
(* time, here's the perfect place to move ourselves to the*)
(* default position on the component list *)
err := SetDefaultComponent(Component(globals^^.self), defaultComponentIdentical + defaultComponentAnyFlagsAnyManufacturer);
end; (* if *)
(* and init the specific globals *)
if err = noErr then begin
junk := ICSOInitShared(globals);
end; (* if *)
end; (* if *)
ICGOGetSharedGlobals := err;
end; (* ICGOGetSharedGlobals *)
(* Component Manager routines *)
function ICGORegister (globals: globalsHandle): ComponentResult;
(* I'd love to allocate shared globals here, but certain *)
(* versions of the Component Manager don't call ICGORegister. *)
(* Additionally, calls to ICGOOpen and ICGOClose bracket *)
(* the call if it does get made. Go figure. *)
(* We actually return a Boolean value, false if we should be*)
(* registered and true if we shouldn't.*)
begin
ICGORegister := 0;
end; (* ICGORegister *)
function ICGOUnregister (globals: globalsHandle): ComponentResult;
(* Eric's comment: *)
(* Does this break if we've been cloned? Does the clone *)
(* get unregistered seperately and double dispose? Hmm. *)
(* FIIK )-: *)
var
result: ComponentResult;
result2: ComponentResult;
begin
result := -1;
if globals^^.shared <> nil then begin
(* give the specifics opportunity to clean up its shared globals *)
result := ICSOCleanShared(globals);
(* clean up our part of the shared globals *)
result2 := UncaptureComponent(globals^^.shared^.delegate);
if result = noErr then begin
result := result2;
end; (* if *)
(* dispose of the shared globals and set our refcon back to nil *)
DisposePtr(Ptr(globals^^.shared));
globals^^.shared := nil;
SetComponentRefcon(Component(globals^^.self), 0);
end; (* if *)
ICGOUnregister := result;
end; (* ICGOUnregister *)
function ICGOCanDo (globals: globalsHandle; selector: integer): ComponentResult;
(* Handle the Component Manager CanDo request.*)
var
result: ComponentResult;
begin
case selector of
kComponentUnregisterSelect..kComponentOpenSelect:
result := 1;
otherwise begin
result := ICSOCanDo(globals, selector);
if result = delegateThisCallErr then begin
result := ComponentFunctionImplemented(globals^^.delegate, selector);
end
else begin
result := result + 1;
end; (* if *)
end;
end; (* case *)
ICGOCanDo := result;
end; (* ICGOCanDo *)
function ICGOFindDelegate (after: Component): Component;
var
cd: ComponentDescription;
found_cd: ComponentDescription;
current: Component;
found: boolean;
begin
cd.componentType := internetConfigurationComponentType;
cd.componentSubType := internetConfigurationComponentSubType;
cd.componentManufacturer := OSType(0);
cd.componentFlags := 0;
cd.componentFlagsMask := 0;
current := after;
found := false;
repeat
current := FindNextComponent(current, cd);
if current <> nil then begin
if GetComponentInfo(current, found_cd, nil, nil, nil) = noErr then begin
found := (found_cd.componentManufacturer <> kOurComponentManufacturer);
end; (* if *)
end; (* if *)
until found or (current = nil);
if current = nil then begin
(* DebugStr('ICGOFindDelegate failed to find one.'); *)
end; (* if *)
ICGOFindDelegate := current;
end; (* ICGOFindDelegate *)
(* ICGOOpen *)
(* This function has been substanially recrafted from the original. Cloning *)
(* is now handled correctly (see the description of ICGOFixCloneRefCon) and error *)
(* handling has been made more graceful by the addition of a dedicated control *)
(* structure. A memory leak has been closed and OpenComponent can no longer *)
(* be called on a NULL component instance. *)
(* If you're using the pascal version, you'll want to carefully examine the *)
(* differences. *)
function ICGOOpen (globals: globalsHandle; self: ComponentInstance): ComponentResult;
var
err: ComponentResult;
cap: Component;
toCapture: Component;
begin
globals := nil;
err := ICGOFixCloneRefCon(self);
if err = noErr then begin
globals := globalsHandle(NewHandleClear(sizeof(globalsRecord)));
err := MemError;
end; (* if *)
if err = noErr then begin
HLock(Handle(globals));
globals^^.self := self;
SetComponentInstanceStorage(self, Handle(globals));
err := ICGOGetSharedGlobals(globals);
end; (* if *)
if err = noErr then begin
(* If we haven't yet done so, find and capture the*)
(* topmost IC component. We'll save the special*)
(* component identifier which will permit us to*)
(* open it.*)
if globals^^.shared^.delegate = nil then begin
toCapture := ICGOFindDelegate(Component(self));
if toCapture = nil then begin
err := icNothingToOverrideErr;
end
else begin
globals^^.shared^.delegate := CaptureComponent(toCapture, Component(self));
end; (* if *)
end; (* if *)
if err = noErr then begin
globals^^.delegate := OpenComponent(globals^^.shared^.delegate);
err := ComponentSetTarget(self, self);
end; (* if *)
if err = noErr then begin
err := ICSOInitGlobals(globals);
end; (* if *)
end; (* if *)
if globals <> nil then begin
HUnlock(Handle(globals));
end; (* if *)
if err <> noErr then begin
if globals <> nil then begin
DisposeHandle(Handle(globals));
SetComponentInstanceStorage(self, nil);
end; (* if *)
end; (* if *)
ICGOOpen := err;
end; (* ICGOOpen *)
function ICGOClose (globals: globalsHandle; self: ComponentInstance): ComponentResult;
(* Handle the Component Manager Close request. *)
var
err: ComponentResult;
junk: OSErr;
begin
err := noErr;
if globals <> nil then begin
junk := ICSOCleanGlobals(globals);
if globals^^.delegate <> nil then begin
junk := CloseComponent(globals^^.delegate)
end; (* if *)
DisposeHandle(Handle(globals));
end; (* if *)
ICGOClose := err;
end; (* ICGOClose *)
function ICGOTarget (globals: globalsHandle; new_target: ComponentInstance): ComponentResult;
(* Handle the Component Manager Target. *)
var
err: ComponentResult;
begin
globals^^.target := new_target;
if globals^^.delegate <> nil then begin
err := ComponentSetTarget(globals^^.delegate, new_target);
end
else begin
err := noErr;
end; (* if *)
ICGOTarget := err;
end; (* ICGOTarget *)
(* Internet Configuration specific routines *)
function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
(* Component entry point. It's pretty neat IMHO. *)
var
proc: ProcPtr;
s: signedByte;
res: longint;
begin
proc := nil;
{$ifc debug_component_entry_exit}
DebugStr(concat('Enter ', SelectorToStr(params.what)));
{$endc}
case params.what of
(* Component Manager stuff *)
kComponentVersionSelect:
Main := internetConfigurationComponentInterfaceVersion;
kComponentCanDoSelect:
proc := @ICGOCanDo;
kComponentOpenSelect:
proc := @ICGOOpen;
kComponentCloseSelect:
proc := @ICGOClose;
kComponentTargetSelect:
proc := @ICGOTarget;
kComponentRegisterSelect:
proc := @ICGORegister;
kComponentUnregisterSelect:
proc := @ICGOUnregister;
(* this component type stuff *)
otherwise
proc := ICSOWhatToOverride(globalsHandle(storage), params.what);
end; (* case *)
if storage <> nil then begin
s := HGetState(storage);
HLock(storage);
end; (* if *)
res := delegateThisCallErr;
if proc <> nil then begin
res := CallComponentFunctionWithStorage(storage, params, proc);
end; (* if *)
if res = delegateThisCallErr then begin
res := DelegateComponentCall(params, globalsHandle(storage)^^.delegate);
end; (* if *)
{$ifc debug_component_entry_exit}
DebugStr(concat('Exit ', SelectorToStr(params.what), ' with result ', ICGODecStr(res)));
{$endc}
Main := res;
if (storage <> nil) and (params.what <> kComponentCloseSelect) then begin
HSetState(storage, s);
end; (* if *)
end; (* Main *)
end. (* ICGenericOverride *)